perm filename FCOPY.FAI[XGP,BGB] blob sn#028343 filedate 1973-05-11 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE FCOPY
C00004 00003	FLUSH EXTRAS AT TOP AND BOTTOM AND WE'RE DONE
C00007 00004	READ XAP FORMAT
C00012 00005	NSUBR(OGLYPH,CHAR,WIDTH,HEIGHT)
C00017 00006	NSUBR(EMIT,N)
C00018 00007	NSUBR(GETFIL)GET FILE SPEC FROM TTY LINE 
C00020 00008	↓INHDR:	0
C00021 ENDMK
C⊗;
	TITLE FCOPY

	↓INCHAN←10
	↓OUTCHAN←11

	↓P←17

	↓ROWMAX←←=200
	↓COLMAX←←=108/=36	;3 WORDS

START:	MOVE P,[IOWD PLEN,PDL]
	RESET
	OUTSTR[ASCIZ/
FONT CONVERTER
INPUT FILE: /]
	CALL(GETFIL)	
	GO START
	HLRZ EXTION
	CAIE 'XAP'
	CAIN 'FNT'
	CAIA
	GO [ OUTSTR[ASCIZ/UNKNOW FONT TYPE.
/]
	     GO START]
	INIT INCHAN,17
	SIXBIT/DSK/
	INHDR
	FATAL(CAN'T INIT DSK)
	LOOKUP INCHAN,FILNAM
	GO [ OUTSTR[ASCIZ/FILE NOT FOUND.
/]↔	     GO START]
	MOVE [XWD FILNAM,IFILE]
	BLT IPPN
START2:	OUTSTR[ASCIZ/OUTPUT FILE: /]
	CALL(GETFIL)
	GO START2
	MOVEI 'FNT'
	SKIPN EXTION
	MOVEM EXTION
	INIT OUTCHAN,10
	SIXBIT/DSK/
	XWD OUTHDR,0
	FATAL(CANIT INIT DSK)
	ENTER OUTCHAN,FILNAM
	GO [ OUTSTR[ASCIZ/FILE PROTECTED OR IN USE.
/]↔	     GO START]
	OUT OUTCHAN,
	CAIA
	FATAL(COULDN'T SET UP BUFFERS FOR DSK)
	HLRZ IEXT
	SETZM PC
	CAIN 'XAP'
	GO FROMXAP
;	CAIN 'KST'
;	GO FROMCMU
	FATAL(UNKNOWN FONT TYPE)
;FLUSH EXTRAS AT TOP AND BOTTOM AND WE'RE DONE
BEGIN FINISH
	ACCUMULATORS{T1,T2,CHAR,ADR}
↑FINISH: CLOSE OUTCHAN,
	CLOSE INCHAN,
	SETSTS OUTCHAN,17
	JFCL
	PUSH P,PPPN
	LOOKUP INCHAN,FILNAM
	FATAL(CAN'T READ FILE I JUST WROTE!)
	HLRE 0,PPPN
	MOVN 0,0
	ADDI $$
	CORE2
	FATAL(CAN'T GET SEGMENT CORE)
	MOVEI 0,377777
	HRRM 0,PPPN
	IN INCHAN,PPPN
	CAIA
	FATAL(READ ERROR)
	MOVE [XWD INDEX,$$]
	BLT $$+177
	MOVEI 377777
	SETZ 1,
	MOVE CHAR,[XWD -200,$$]
FL1:	SKIPG ADR,(CHAR)
	GO FNDF
	HLRE T1,$$+1(ADR)
	JUMPL T1,[FATAL(NEGATIVE TOP COUNT)]
	CAMGE T1,0
	MOVEM T1,0
	HRRE T2,$$+1(ADR)
	JUMPL T1,[FATAL(NEGATIVE DATA COUNT)]
	ADD T2,T1
	CAMLE T2,1
	MOVEM T2,1
FNDF:	AOBJN CHAR,FL1
	MOVNS 0
	ADD 1,0
	MOVEM 1,$$+201
	ADDM $$+203
	HRLZ 0,0
	MOVE CHAR,[XWD -200,$$]
FL2:	SKIPLE ADR,(CHAR)
	ADDM 0,$$+1(ADR)
	AOBJN CHAR,FL2
	CLOSE INCHAN,
	MOVE PPPN
	EXCH (P)
	MOVEM PPPN
	SKIPN CMUFLG
	JRST FL3
	MOVE $$+201
	CAMN $$+203
	JRST FL3
	IDIVI 5	
	MOVN
	ADDM $$+203
FL3:	ENTER OUTCHAN,FILNAM
	GO [OUTSTR[ASCIZ/SOMEONE IS REFERENCING YOUR OUTPUT FILE, TYPE CONTINUE TO RETRY./]
	    CALLI 1,12
	    GO FL3]
	POP P,PPPN
	OUT OUTCHAN,PPPN
	GO [	CLOSE OUTCHAN,
		GO START]
	FATAL(WRITE ERROR)
BEND FINISH
CMUFLG:	0
;READ XAP FORMAT
BEGIN XAP
	ACCUMULATORS {T1,T2,T3,T4,T5,T6,CHAR,ADR}
↑FROMXAP: MOVEI 377777
	HRRM IPPN
	HLRE IPPN
	MOVN
	ADDI $$
	CORE2	
	FATAL(SEGMENT CORE NOT AVAILABLE)
	STATO INCHAN,17
	JFCL
	IN INCHAN,IPPN
	CAIA
	FATAL(READ ERROR)
	SETZM INDEX		;ZERO INDEX
	MOVE [XWD INDEX,INDEX+1]
	BLT INDEX+177
	SETZM MAXHEIGHT
	SETZM MAXWIDTH
	MOVSI CHAR,-200
MLOOP:	SKIPG ADR,$$(CHAR)
	GO MNODEF
	ADDI ADR,$$
	HLRE (ADR)
	CAMLE MAXHEIGHT
	MOVEM MAXHEIGHT
	HLRE T1,1(ADR)
	HLRE (ADR)
	ADD T1,0
	CAMGE T1,BASELINE
	MOVEM T1,BASELINE
	HRRE 1,2(ADR)
	HRRE T1,1(ADR)
	ADD T1,1
	CAMLE T1,MAXWIDTH
	MOVEM T1,MAXWIDTH
MNODEF:	AOBJN CHAR,MLOOP
	MOVEI 200		;RESERVE SPACE FOR INDEX
	ADDM OUTPTR
	ADDM PC
	OUT OUTCHAN,
	CAIA
	FATAL(WRITE ERROR)
	CALL(EMIT,[0])		;CHARACTER SET NUMBER
	OUTSTR[ASCIZ/  MAX. WIDTH = /]
	CALL(OUTNUM,MAXWIDTH,[=10])
	MOVE T1,MAXHEIGHT
	SUB T1,BASELINE
	CALL(EMIT,T1)		;MAXIMUM HEIGHT
	OUTSTR[ASCIZ/
  MAX. HEIGHT = /]
	CALL(OUTNUM,T1,[=10])
	CALL(EMIT,MAXWIDTH)	;MAXIMUM WIDTH
	CALL(EMIT,MAXHEIGHT)	;TOP - BASE LINE
	OUTSTR[ASCIZ/
  BASE LINE (ABOVE BOTTOM) = /]
	MOVN T1,BASELINE
	CALL(OUTNUM,T1,[=10])
	MOVEI 140
ABC:	CAME OUTCNT
	GO [ IBP OUTPTR
	     SOSLE OUTCNT
	     GO ABC
	     FATAL(I'M CONFUSED ABOUT MY I/O)]
	OUTSTR[ASCIZ/
TYPE DESCRIPTION FOLLOWED BY <ALTMODE>:
/]
	MOVEI 7
	DPB [POINT 6,OUTPTR,11]
	MOVEI 5
	IMULM OUTCNT
DEF:	INCHWL 
	CAIE 175
	GO [SOSG OUTCNT
	    GO [ OUTSTR[ASCIZ/LINE TRUNCATED, DESCRIPTION TOO LONG.
/]
		 GO XXX]
	    IDPB OUTPTR
	    GO DEF]
XXX:	MOVEI 44
	DPB [POINT 12,OUTPTR,11]
XYZ:	HRRZ OUTHDR
	ADDI 201
	HRRM OUTPTR
	OUT OUTCHAN,
	CAIA
	FATAL(WRITE ERROR)
	AOS OUTCNT		;GOD ONLY KNOWS WHY I HAVE TO DO THIS!
	MOVEI 400
	MOVEM PC
	MOVSI CHAR,-200
LOOP:	SKIPG ADR,$$(CHAR)
	GO NODEF
	SETZM GBUF
	MOVE [XWD GBUF,GBUF+1]
	BLT GEND
	ADDI ADR,$$
	MOVE T1,MAXHEIGHT
	HLRE T2,1(ADR)
	ADD T1,T2
	IMUL T1,ROWIDTH
	ADD T1,[POINT 1,GBUF,-1]
	MOVEI T2,3(ADR)
	HRLI T2,440100
	HLRE T3,(ADR)
	HRRE T4,(ADR)
	IMULI T4,=36
	MOVEM T4,ROWCOUNT
	JUMPE T4,NODEF
L1:	HRRE T4,1(ADR)
	JUMPE T4,C1
	SETZ 1,
L2:	IDPB 1,T1
	SOJG T4,L2
C1:	MOVE T4,ROWCOUNT
	JUMPE T4,C2
L3:	ILDB 1,T2
	IDPB 1,T1
	SOJG T4,L3
	HRRZI 0,-GBUF(T1)
	MOVE T1,ROWIDTH
	IDIVM 0,T1
	ADDI T1,1
	MOVE 0,ROWIDTH
	IMULM 0,T1
	ADD T1,[POINT 1,GBUF,-1]
	TLZ T2,440000
	SOJG T3,L1
C2:	HRRE 1,2(ADR)
	HRRE T1,1(ADR)
	JUMPL T1,[FATAL(BACKSPACING ILLEGAL IN NEW FORMAT)]
	ADD 1,T1
	PUSH P,CHAR
	CALL(OGLYPH,CHAR,1,MAXHEIGHT)
	POP P,CHAR
	OUTCHR CHAR
NODEF:	AOBJN CHAR,LOOP
	GO FINISH

MAXHEIGHT:	0
MAXWIDTH:	0
BASELINE:	0
ROWCOUNT:	0

BEND XAP
NSUBR(OGLYPH,CHAR,WIDTH,HEIGHT)
	ACCUMULATORS {FIRST,T1,LAST,T3,T4}
	MOVE 1,CHAR
	MOVE 0,WIDTH
	HRL 0,PC
	MOVSM 0,INDEX(1)	;UPDATE INDEX
	MOVE 1,ROWIDTH
	ADDI 1,1
	IMUL 1,HEIGHT		;FIND MAX WORD TO CHECK
	SETZB FIRST,LAST
	MOVE T1,[XWD ACCODE,T3]	;BLT LOOP INTO AC'S
	BLT T1,T3+ACCONT-ACCODE
	GO T3
ACCODE:	PHASE T3
	SKIPN GBUF(1)		;FIND LAST NON-ZERO WORD
 	SOJGE 1,.-1
	JUMPLE 1,NONE
	MOVE LAST,1
	SKIPE GBUF(1)		;REMEMBER LAST NON-ZERO WORD
	MOVE FIRST,1		;(REALLY THE FIRST, WE'RE MOVING
	SOJGE 1,.-2		;BACKWARDS)
	GO ACCONT
	DEPHASE
ACCONT:
IFG <ACCONT-ACCODE+T3-15><YOU LOSER, YOU PUT TO MUCH IN ACCODE>
	IDIV LAST,ROWIDTH	;CALCULATE ROWS OF NON-ZERO DATA AREA
	MOVE T3,FIRST
	IDIV T3,ROWIDTH
	MOVEM T3,TOPS		;SAVE NUMBER OF BLANKS
	SUB LAST,T3
	ADDI LAST,1
	MOVEM LAST,ROWS		;SAVE NUMBER OF ROWS
	JUMPE [FATAL(UNEXPECTED ZERO ROW COUNT!)]
	MOVEI T3,=36		;CALCULATE BYTES/WORD
	IDIV T3,WIDTH
	JUMPE T3,MULTWD
	MOVEM T3,BYTWRD		;SAVE IN BYTWRD
CALCWC:	MOVE T3,ROWS		;CALCULATE WORD COUNT
	SUBI T3,1		;WC=(ROWS-1)/BYTWRD+1
	IDIV T3,BYTWRD
	ADDI T3,1
	ADDI T3,2		;TWO MORE FOR HEADER
	HRL T3,CHAR
	CALL(EMIT,T3)		;EMIT CHAR,,WORD COUNT
	MOVE T3,ROWS
	HRL T3,TOPS
	JUMPL T3,[FATAL(NEGATIVE TOP COUNT)]
	CALL(EMIT,T3)		;EMIT TOP ROWS,DATA ROWS
	MOVEI T3,=36
	SUB T3,WIDTH
	ASH T3,6
	ADD T3,WIDTH
	ADDI FIRST,GBUF
	DPB T3,[POINT 12,FIRST,11]
	MOVE T3,WIDTH
	ADDI T3,100*=36
	DPB T3,[POINT 12,FOOPTR,11]
	MOVE T3,ROWS
	JUMPE T3,[FATAL(ZERO ROW COUNT!)]
LL1:	SETZ 0,
	MOVE T4,BYTWRD
	MOVE LAST,FOOPTR
LL2:	SOJL T4,[ CALL(EMIT,0)
		  GO LL1]
	LDB 1,FIRST
LL2A:	IDPB 1,LAST
	ADD FIRST,ROWIDTH
	SOJG T3,LL2
	CALL(EMIT,0)
	POP3J
NONE:	MOVEI 1,2
	HRL 1,CHAR
	CALL(EMIT,1)
 	CALL(EMIT,[0])
	POP3J
MULTWD:	MOVE T3,WIDTH
	ADDI T3,=35
	IDIVI T3,=36
	MOVNM T3,NWRDROW
	IMUL T3,ROWS
	ADDI T3,2
	HRL T3,CHAR
	CALL(EMIT,T3)
	MOVE T3,ROWS
	HRL T3,TOPS
	CALL(EMIT,T3)
	MOVE T4,ROWS
LL3:	HRL FIRST,NWRDROW
LL4:	MOVE T1,GBUF(FIRST)
	CALL(EMIT,T1)
	AOBJN FIRST,LL4
	ADD FIRST,ROWIDTH
	ADD FIRST,NWRDROW
	SOJG T4,LL3
	POP3J
TOPS:	0
BYTWRD:	0
NWRDROW: 0
ROWS:	0
FOOPTR:	0
SUBREND OGLYPH;20-FEB-73(TVR)
NSUBR(EMIT,N)
	SOSG OUTCNT
	OUT OUTCHAN,
	GO [ EXCH 1,N
	     IDPB 1,OUTPTR
	     EXCH 1,N
	     AOS PC
	     POP1J]
	FATAL (WRITE ERROR)
SUBREND EMIT

NSUBR(OUTNUM,VAL,BASE)
	EXCH 0,BASE
	EXCH 1,VAL
	PUSH P,2
	PUSHJ P,OUTNU2
	POP P,2
	MOVE 1,VAL
	MOVE 0,BASE
	POP2J
OUTNU2:	IDIV 1,0
	JUMPE 1,OUTNU3
	HRLM 2,(P)
	PUSHJ P,OUTNU2
	HLRZ 2,(P)
OUTNU3:	ADDI 2,"0"
	OUTCHR 2
	POP0J
SUBREND OUTNUM
NSUBR(GETFIL)GET FILE SPEC FROM TTY LINE 

	SETZM FILNAM↔SETZM EXTION
	SETZM EXTION+1↔SETZM PPPN
;	CRLF
	MOVE 4,[POINT 6,FILNAM,-1]↔MOVEI 2,6
	INCHWL 1↔CAIN 1,15↔GO[INCHWL↔POP0J]↔AOS(P)
	JRST L+1
L:	INCHWL 1
	CAILE 1,"z"↔POP0J
	CAIL 1,"a"↔SUBI 1,40		;CONVERT LOWER CASE
	CAIN 1,"."↔GO[MOVE 4,[POINT 6,EXTION,-1]↔MOVEI 2,3↔GO L]
	CAIN 1,"["↔GO[MOVE 4,[POINT 6,PPPN,-1]  ↔MOVEI 2,3↔GO L]
	CAIN 1,","↔GO[HLRZ PPPN
		      PUSHJ P,[PPJUST:	JUMPE [OUTSTR[ASCIZ/BAD P,PN/]
						CLRBFI↔SOS -1(P)↔CRLF↔POP1J]	
		   	 		TRNE 77↔POP0J↔LSH -6↔GO PPJUST]
		      HRLM PPPN↔MOVE 4,[POINT 6,PPPN,17]↔MOVEI 2,3↔GO L]
	CAIN 1,"]"↔GO[HRRZ PPPN↔CALL(PPJUST)
		   HRRM PPPN↔INCHWL 1↔GO FINQ]
FINQ:	CAIN 1,15↔GO EOL			;END OF THE LINE.
	CAIN 1,12↔POP0J
	CAIN 1,"→"↔POP0J
	CAIG 1," "↔GO L	;IGNORE GARBAGE.
	SOJL 2,L↔SUBI 1,40↔IDPB 1,4↔GO L

EOL:	INCHWL 1↔POP0J
SUBREND GETFIL;1/31/73(BGB),2/7/73(TVR)
↓INHDR:	0
↓INPTR:	0
↓INCNT:	0

↓FILNAM: 0
↓EXTION: 0
	 0
↓PPPN:	 0
	 0

↓IFILE:	0
↓IEXT:	0
	0
↓IPPN:	0
	0

↓OUTHDR: 0
↓OUTPTR: 0
↓OUTCNT: 0

↓INDEX:	BLOCK 200
↓GBUF:	BLOCK ROWMAX*COLMAX
↓GEND←←.-1

↓ROWIDTH: COLMAX

↓PC:	0

PDL:	BLOCK 20
PLEN←←.-PDL
PATCH:	BLOCK 20
	END START